00010	BEGIN
00020	DEFINE ⊂="COMMENT",CR="'15",LF="'12", CRLF="CR&LF",TB="'11";
00030	REQUIRE "KIPLA2.REL[KI,ALS]" LOAD_MODULE;
00040	REQUIRE "FIXUPA.REL[X,ALS]" LIBRARY;
00050	REQUIRE "IO.REL[X,ALS]" LIBRARY;
00060	REQUIRE "SUIO.REL[X,ALS]" LIBRARY;
00070	REQUIRE "LIB.REL[NET,NJM]" LIBRARY;
00080	EXTERNAL FORTRAN PROCEDURE KIPLAY;
00090	INTEGER ARRAY NAMES[0:100];
00100	INTEGER ARRAY DUMMY[1:2];
00110	INTEGER ARRAY NAME[0:5];
00120	INTEGER CHAN1,CHAN2,NEW,I,EOF,PP,SEGNAM;
00130	STRING READ,READ2,READ3;
00140	BOOLEAN ER;
00150	
00160	PROCEDURE SAY;
00170	BEGIN "SAY"
00180	
00190	INTEGER I,J;
00200	STRING READ2,READ3;
00210	
00220	READ3←"";
00230	FOR I←1 STEP 1 UNTIL 5 DO BEGIN
00240	  FOR J←1 STEP 1 UNTIL 5 DO BEGIN
00250	    READ3←READ3&READ[1 TO 1];
00260	    READ←READ[2 TO 20];
00270	    END;
00280	  NAME[I]←CVASC(READ3);
00290	  READ3←"";
00300	  END;
00310	
00320	START_CODE '047000400037; MOVEM 0,SEGNAM; '047040400017; END;
00330	⊂ Get segment name and detach;
00340	  KIPLAY(NAME[1],DUMMY[1]);
00350	START_CODE MOVE 0,SEGNAM; '047000400016; JFCL; END;
00360	⊂ Reattach segment so exit will be in order;
00370	END "SAY";
00380	
00390	
00400	
00410	OUTSTR("This program allows one to hear a file, to rename it and to add the"
00420	   &CRLF&TB&
00430	    " new file name to the list (in sixbit) in file KILIST.SIX"&CRLF);
00440	
00450	OUTSTR("A space only as old name is taken to mean LISTEN.TMP"&CRLF
00460	  &"A ? will cause the list in KILIST.SIX to be typed"&CRLF
00470	      &"A CR only terminates the session"&CRLF);
00480	CHAN1←1; CHAN2←2;
00490	START_CODE MOVE 0,['325004000000]; '047000400110; END;
00500	
00510	    CLOSE(CHAN2); OPEN (CHAN2,"DSK",'10,2,0,0,0,EOF);
00520	    LOOKUP(CHAN2,"KILIST.SIX[KI,ALS]",ER);
00530	    ARRYIN(CHAN2,NAMES[0],100);
00540	
00550	WHILE TRUE DO BEGIN "LOOP"
00560	  OUTSTR(CRLF&"Type the old file name (with extension) ");
00570	  ER←1; WHILE ER DO BEGIN "OLD"
00580	    IF ( READ←INCHWL)="" THEN DONE "LOOP";
00590	    IF READ=" " THEN READ←"LISTEN.TMP";
00600	
00610	    IF READ="?" THEN BEGIN
00620	      OUTSTR(CRLF& "The following files are listed)"&CRLF&LF);
00630	      FOR I←0 STEP 1 UNTIL 99 DO BEGIN
00640	        IF NAMES[I]=0 THEN DONE;
00650	        OUTSTR(CVXSTR(NAMES[I])&".SAY"&CRLF);
00660	        END;
00670	      CONTINUE "LOOP";
00680	      END;
00690	
00700	    CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,1,1,0,0,EOF);
00710	    LOOKUP(CHAN1,READ,ER);
00720	    IF ER THEN OUTSTR("File "&READ&" could not be found. "
00730	      &CRLF&"Try again ")
00740	    ELSE DONE;
00750	    END "OLD";
00760	
00770	SAY;
00780	
00790	  WHILE TRUE DO BEGIN "NEWN"
00800	  OUTSTR("Now type new name"&CRLF&
00810	      " (CR only leaves old name unchanged and unrecorded) ");
00820	    IF ( READ2←INCHWL)="" THEN CONTINUE "LOOP";
00830	
00840	    IF READ2="?" THEN BEGIN
00850	      OUTSTR(CRLF& "The following files are listed)"&CRLF&LF);
00860	      FOR I←0 STEP 1 UNTIL 99 DO BEGIN
00870	        IF NAMES[I]=0 THEN DONE;
00880	        OUTSTR(CVXSTR(NAMES[I])&".SAY"&CRLF);
00890	        END;
00900	      CONTINUE "NEWN";
00910	      END;
00920	
00930	    READ3←"";
00940	
00950	    FOR I←0 STEP 1 UNTIL 5 DO BEGIN
00960	      IF READ2[1 TO 1]="." THEN DONE;
00970	      READ3←READ3&READ2[1 TO 1]; READ2←READ2[2 TO 5]; END;
00980	
00990	    NEW←CVSIX(READ3);
01000	
01010	    FOR I←0 STEP 1 UNTIL 99 DO BEGIN
01020	      IF NAMES[I]=0 THEN DONE "NEWN";
01030	      IF NAMES[I]=NEW THEN BEGIN
01040	        OUTSTR("New name already has been used"
01050	         &CRLF&"Try again or CR to void request "&CRLF);
01060	        DONE;
01070	        END;
01080	      END;
01090	    END "NEWN";
01100	
01110	  NAMES[I]←NEW;
01120	
01130	  CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,0,2,0,0,0);
01140	  ENTER(CHAN2,"KILIST.SIX[KI,ALS]",0);
01150	  ARRYOUT(CHAN2,NAMES[0],100);
01160	  CLOSE(CHAN2);
01170	  
01180	  CLOSE(CHAN1); RENAME(CHAN1,READ3&".SAY",0,0);
01190	  RELEASE(CHAN1);
01200	  END "LOOP";
01210	
01220	START_CODE MOVE 0,['325000000000]; '047000400110; END;
01230	
01240	END;